home *** CD-ROM | disk | FTP | other *** search
/ Delphi 5 for Professionals / DELPHI5.iso / AddOns / Components / TEECHART / DELPHI3.EXE / %MAINDIR% / Examples / Delphi3 / ActiveX Form / TeeAXImp.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-11-17  |  12.4 KB  |  453 lines

  1. unit TeeAXImp;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ActiveX, AxCtrls, StdCtrls, ExtCtrls, TeeProcs, TeEngine, Chart, Buttons,
  8.   Series, TeeX_TLB;
  9.  
  10. type
  11.   TTeeAxForm = class(TActiveForm, ITeeAxForm)
  12.     Chart1: TChart;
  13.     Panel1: TPanel;
  14.     Panel2: TPanel;
  15.     EditButton: TBitBtn;
  16.     PrintButton: TBitBtn;
  17.     ExportButton: TBitBtn;
  18.     ComboBox1: TComboBox;
  19.     SaveButton: TBitBtn;
  20.     SaveDialog1: TSaveDialog;
  21.     CheckBox1: TCheckBox;
  22.     Series1: TPieSeries;
  23.     Timer1: TTimer;
  24.     DownloadButton: TBitBtn;
  25.     BitBtn1: TBitBtn;
  26.     CheckBox2: TCheckBox;
  27.     procedure EditButtonClick(Sender: TObject);
  28.     procedure PrintButtonClick(Sender: TObject);
  29.     procedure ExportButtonClick(Sender: TObject);
  30.     procedure SaveButtonClick(Sender: TObject);
  31.     procedure CheckBox1Click(Sender: TObject);
  32.     procedure ComboBox1Change(Sender: TObject);
  33.     procedure ComboBox1KeyPress(Sender: TObject; var Key: Char);
  34.     procedure Timer1Timer(Sender: TObject);
  35.     procedure FormCreate(Sender: TObject);
  36.     procedure CheckBox2Click(Sender: TObject);
  37.     procedure DownloadButtonClick(Sender: TObject);
  38.     procedure BitBtn1Click(Sender: TObject);
  39.     procedure Series1Click(Sender: TChartSeries; ValueIndex: Integer;
  40.       Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  41.   private
  42.     { Private declarations }
  43.     FEvents: IChartXEvents;
  44.     procedure ActivateEvent(Sender: TObject);
  45.     procedure ClickEvent(Sender: TObject);
  46.     procedure CreateEvent(Sender: TObject);
  47.     procedure DblClickEvent(Sender: TObject);
  48.     procedure DeactivateEvent(Sender: TObject);
  49.     procedure DestroyEvent(Sender: TObject);
  50.     procedure KeyPressEvent(Sender: TObject; var Key: Char);
  51.     procedure PaintEvent(Sender: TObject);
  52.   protected
  53.     { Protected declarations }
  54.     procedure EventSinkChanged(const EventSink: IUnknown); override;
  55.     procedure Initialize; override;
  56.     function Get_Active: WordBool; safecall;
  57.     function Get_AutoScroll: WordBool; safecall;
  58.     function Get_AxBorderStyle: TxActiveFormBorderStyle; safecall;
  59.     function Get_Caption: WideString; safecall;
  60.     function Get_Color: Integer; safecall;
  61.     function Get_Cursor: Smallint; safecall;
  62.     function Get_DropTarget: WordBool; safecall;
  63.     function Get_Enabled: WordBool; safecall;
  64.     function Get_HelpFile: WideString; safecall;
  65.     function Get_KeyPreview: WordBool; safecall;
  66.     function Get_PixelsPerInch: Integer; safecall;
  67.     function Get_PrintScale: TxPrintScale; safecall;
  68.     function Get_Scaled: WordBool; safecall;
  69.     function Get_Visible: WordBool; safecall;
  70.     function Get_WindowState: TxWindowState; safecall;
  71.     procedure Set_AutoScroll(Value: WordBool); safecall;
  72.     procedure Set_AxBorderStyle(Value: TxActiveFormBorderStyle); safecall;
  73.     procedure Set_Caption(const Value: WideString); safecall;
  74.     procedure Set_Color(Value: Integer); safecall;
  75.     procedure Set_Cursor(Value: Smallint); safecall;
  76.     procedure Set_DropTarget(Value: WordBool); safecall;
  77.     procedure Set_Enabled(Value: WordBool); safecall;
  78.     procedure Set_HelpFile(const Value: WideString); safecall;
  79.     procedure Set_KeyPreview(Value: WordBool); safecall;
  80.     procedure Set_PixelsPerInch(Value: Integer); safecall;
  81.     procedure Set_PrintScale(Value: TxPrintScale); safecall;
  82.     procedure Set_Scaled(Value: WordBool); safecall;
  83.     procedure Set_Visible(Value: WordBool); safecall;
  84.     procedure Set_WindowState(Value: TxWindowState); safecall;
  85.     function Get_ChartColor: Integer; safecall;
  86.     procedure Set_ChartColor(Value: Integer); safecall;
  87.   public
  88.     { Public declarations }
  89.     Procedure DownloadChart;
  90.   end;
  91.  
  92. implementation
  93.  
  94. uses ComServ,URLMon,TeeStore,TeePrevi,Teexport,EditChar,TeeAbout,IEdiGene;
  95.  
  96. {$R *.DFM}
  97.  
  98. { TCacaX }
  99.  
  100. procedure TTeeAxForm.EventSinkChanged(const EventSink: IUnknown);
  101. begin
  102.   FEvents := EventSink as IChartXEvents;
  103. end;
  104.  
  105. procedure TTeeAxForm.Initialize;
  106. begin
  107.   OnActivate := ActivateEvent;
  108.   OnClick := ClickEvent;
  109.   OnCreate := CreateEvent;
  110.   OnDblClick := DblClickEvent;
  111.   OnDeactivate := DeactivateEvent;
  112.   OnDestroy := DestroyEvent;
  113.   OnKeyPress := KeyPressEvent;
  114.   OnPaint := PaintEvent;
  115. end;
  116.  
  117. function TTeeAxForm.Get_Active: WordBool;
  118. begin
  119.   Result := Active;
  120. end;
  121.  
  122. function TTeeAxForm.Get_AutoScroll: WordBool;
  123. begin
  124.   Result := AutoScroll;
  125. end;
  126.  
  127. function TTeeAxForm.Get_AxBorderStyle: TxActiveFormBorderStyle;
  128. begin
  129.   Result := Ord(AxBorderStyle);
  130. end;
  131.  
  132. function TTeeAxForm.Get_Caption: WideString;
  133. begin
  134.   Result := WideString(Caption);
  135. end;
  136.  
  137. function TTeeAxForm.Get_Color: Integer;
  138. begin
  139.   Result := Integer(Color);
  140. end;
  141.  
  142. function TTeeAxForm.Get_Cursor: Smallint;
  143. begin
  144.   Result := Smallint(Cursor);
  145. end;
  146.  
  147. function TTeeAxForm.Get_DropTarget: WordBool;
  148. begin
  149.   Result := DropTarget;
  150. end;
  151.  
  152. function TTeeAxForm.Get_Enabled: WordBool;
  153. begin
  154.   Result := Enabled;
  155. end;
  156.  
  157. function TTeeAxForm.Get_HelpFile: WideString;
  158. begin
  159.   Result := WideString(HelpFile);
  160. end;
  161.  
  162. function TTeeAxForm.Get_KeyPreview: WordBool;
  163. begin
  164.   Result := KeyPreview;
  165. end;
  166.  
  167. function TTeeAxForm.Get_PixelsPerInch: Integer;
  168. begin
  169.   Result := PixelsPerInch;
  170. end;
  171.  
  172. function TTeeAxForm.Get_PrintScale: TxPrintScale;
  173. begin
  174.   Result := Ord(PrintScale);
  175. end;
  176.  
  177. function TTeeAxForm.Get_Scaled: WordBool;
  178. begin
  179.   Result := Scaled;
  180. end;
  181.  
  182. function TTeeAxForm.Get_Visible: WordBool;
  183. begin
  184.   Result := Visible;
  185. end;
  186.  
  187. function TTeeAxForm.Get_WindowState: TxWindowState;
  188. begin
  189.   Result := Ord(WindowState);
  190. end;
  191.  
  192. procedure TTeeAxForm.Set_AutoScroll(Value: WordBool);
  193. begin
  194.   AutoScroll := Value;
  195. end;
  196.  
  197. procedure TTeeAxForm.Set_AxBorderStyle(Value: TxActiveFormBorderStyle);
  198. begin
  199.   AxBorderStyle := TActiveFormBorderStyle(Value);
  200. end;
  201.  
  202. procedure TTeeAxForm.Set_Caption(const Value: WideString);
  203. begin
  204.   Caption := TCaption(Value);
  205. end;
  206.  
  207. procedure TTeeAxForm.Set_Color(Value: Integer);
  208. begin
  209.   Color := TColor(Value);
  210. end;
  211.  
  212. procedure TTeeAxForm.Set_Cursor(Value: Smallint);
  213. begin
  214.   Cursor := TCursor(Value);
  215. end;
  216.  
  217. procedure TTeeAxForm.Set_DropTarget(Value: WordBool);
  218. begin
  219.   DropTarget := Value;
  220. end;
  221.  
  222. procedure TTeeAxForm.Set_Enabled(Value: WordBool);
  223. begin
  224.   Enabled := Value;
  225. end;
  226.  
  227. procedure TTeeAxForm.Set_HelpFile(const Value: WideString);
  228. begin
  229.   HelpFile := String(Value);
  230. end;
  231.  
  232. procedure TTeeAxForm.Set_KeyPreview(Value: WordBool);
  233. begin
  234.   KeyPreview := Value;
  235. end;
  236.  
  237. procedure TTeeAxForm.Set_PixelsPerInch(Value: Integer);
  238. begin
  239.   PixelsPerInch := Value;
  240. end;
  241.  
  242. procedure TTeeAxForm.Set_PrintScale(Value: TxPrintScale);
  243. begin
  244.   PrintScale := TPrintScale(Value);
  245. end;
  246.  
  247. procedure TTeeAxForm.Set_Scaled(Value: WordBool);
  248. begin
  249.   Scaled := Value;
  250. end;
  251.  
  252. procedure TTeeAxForm.Set_Visible(Value: WordBool);
  253. begin
  254.   Visible := Value;
  255. end;
  256.  
  257. procedure TTeeAxForm.Set_WindowState(Value: TxWindowState);
  258. begin
  259.   WindowState := TWindowState(Value);
  260. end;
  261.  
  262. procedure TTeeAxForm.ActivateEvent(Sender: TObject);
  263. begin
  264.   if FEvents <> nil then FEvents.OnActivate;
  265. end;
  266.  
  267. procedure TTeeAxForm.ClickEvent(Sender: TObject);
  268. begin
  269.   if FEvents <> nil then FEvents.OnClick;
  270. end;
  271.  
  272. procedure TTeeAxForm.CreateEvent(Sender: TObject);
  273. begin
  274.   if FEvents <> nil then FEvents.OnCreate;
  275. end;
  276.  
  277. procedure TTeeAxForm.DblClickEvent(Sender: TObject);
  278. begin
  279.   if FEvents <> nil then FEvents.OnDblClick;
  280. end;
  281.  
  282. procedure TTeeAxForm.DeactivateEvent(Sender: TObject);
  283. begin
  284.   if FEvents <> nil then FEvents.OnDeactivate;
  285. end;
  286.  
  287. procedure TTeeAxForm.DestroyEvent(Sender: TObject);
  288. begin
  289.   if FEvents <> nil then FEvents.OnDestroy;
  290. end;
  291.  
  292. procedure TTeeAxForm.KeyPressEvent(Sender: TObject; var Key: Char);
  293. var
  294.   TempKey: Smallint;
  295. begin
  296.   TempKey := Smallint(Key);
  297.   if FEvents <> nil then FEvents.OnKeyPress(TempKey);
  298.   Key := Char(TempKey);
  299. end;
  300.  
  301. procedure TTeeAxForm.PaintEvent(Sender: TObject);
  302. begin
  303.   if FEvents <> nil then FEvents.OnPaint;
  304. end;
  305.  
  306. Function URLErrorToString(ErrorCode:HResult):String;
  307. begin
  308.   if ErrorCode=INET_E_INVALID_URL               then  result :='INET_E_INVALID_URL' else
  309.   if ErrorCode=INET_E_NO_SESSION                then  Result :='INET_E_INVALID_URL' else
  310.   if ErrorCode=INET_E_CANNOT_CONNECT            then  Result :='INET_E_CANNOT_CONNECT'  else
  311.   if ErrorCode=INET_E_RESOURCE_NOT_FOUND        then  Result :='INET_E_RESOURCE_NOT_FOUND'  else
  312.   if ErrorCode=INET_E_OBJECT_NOT_FOUND          then  Result :='INET_E_OBJECT_NOT_FOUND'  else
  313.   if ErrorCode=INET_E_DATA_NOT_AVAILABLE        then  Result :='INET_E_DATA_NOT_AVAILABLE'  else
  314.   if ErrorCode=INET_E_DOWNLOAD_FAILURE          then  Result :='INET_E_DOWNLOAD_FAILURE'  else
  315.   if ErrorCode=INET_E_AUTHENTICATION_REQUIRED   then  Result :='INET_E_AUTHENTICATION_REQUIRED'   else
  316.   if ErrorCode=INET_E_NO_VALID_MEDIA            then  Result :='INET_E_NO_VALID_MEDIA'  else
  317.   if ErrorCode=INET_E_CONNECTION_TIMEOUT        then  Result :='INET_E_CONNECTION_TIMEOUT'  else
  318.   if ErrorCode=INET_E_INVALID_REQUEST           then  Result :='INET_E_INVALID_REQUEST'  else
  319.   if ErrorCode=INET_E_UNKNOWN_PROTOCOL          then  Result :='INET_E_UNKNOWN_PROTOCOL'  else
  320.   if ErrorCode=INET_E_SECURITY_PROBLEM          then  Result :='INET_E_SECURITY_PROBLEM'  else
  321.   if ErrorCode=INET_E_CANNOT_LOAD_DATA          then  Result :='INET_E_CANNOT_LOAD_DATA' else
  322.   if ErrorCode=INET_E_CANNOT_INSTANTIATE_OBJECT then  Result :='INET_E_CANNOT_INSTANTIATE_OBJECT' else
  323.   if ErrorCode=INET_E_ERROR_FIRST               then  Result :='INET_E_ERROR_FIRST'  else
  324.   if ErrorCode=INET_E_ERROR_LAST                then  Result :='INET_E_ERROR_LAST' ;
  325. end;
  326.  
  327. Procedure TTeeAxForm.DownloadChart;
  328. var tmp:HResult;
  329.     tmpChart:TCustomChart;
  330.     LocalFile,St:Array[0..255] of Char;
  331. begin
  332.   Timer1.Enabled:=False;
  333.   CheckBox2.Enabled:=False;
  334.   if GetTempPath(SizeOf(St),St)=0 then
  335.      raise Exception.Create('Cannot get the Windows TEMP path');
  336.   if GetTempFileName(St,'TMPTEE',0,LocalFile)=0 then
  337.      raise Exception.Create('Cannot get a TEMP file name');
  338.   tmp:=URLDownloadToFileA(ComObject,PChar(ComboBox1.Text),LocalFile,0,nil);
  339.   if tmp=0 then
  340.   begin
  341.     Chart1.Free;
  342.     tmpChart:=TChart.Create(Self);
  343.     LoadChartFromFile(tmpChart,LocalFile);
  344.     Chart1:=tmpChart as TChart;
  345.     Chart1.Align:=alClient;
  346.     Chart1.Parent:=Self;
  347.     DownloadButton.Enabled:=False;
  348.   end
  349.   else
  350.   begin
  351.     Screen.Cursor:=crDefault;
  352.     ShowMessage('Error code: '+URLErrorToString(tmp)+' downloading: '+ComboBox1.Text);
  353.   end;
  354. end;
  355.  
  356. procedure TTeeAxForm.EditButtonClick(Sender: TObject);
  357. begin
  358.   EditChart(nil,Chart1);
  359. end;
  360.  
  361. procedure TTeeAxForm.PrintButtonClick(Sender: TObject);
  362. begin
  363.   ChartPreview(nil,Chart1);
  364. end;
  365.  
  366. procedure TTeeAxForm.ExportButtonClick(Sender: TObject);
  367. begin
  368.   ChartExport(nil,Chart1);
  369. end;
  370.  
  371. procedure TTeeAxForm.SaveButtonClick(Sender: TObject);
  372. begin
  373.   if SaveDialog1.Execute then  SaveChartToFile(Chart1,SaveDialog1.FileName);
  374. end;
  375.  
  376. procedure TTeeAxForm.CheckBox1Click(Sender: TObject);
  377. begin
  378.   Chart1.View3D:=CheckBox1.Checked;
  379. end;
  380.  
  381. procedure TTeeAxForm.ComboBox1Change(Sender: TObject);
  382. begin
  383.   DownloadButton.Enabled:=True;
  384. end;
  385.  
  386. function TTeeAxForm.Get_ChartColor: Integer;
  387. begin
  388.   result:=Chart1.Color;
  389. end;
  390.  
  391. procedure TTeeAxForm.Set_ChartColor(Value: Integer);
  392. begin
  393.   Chart1.Color:=Value;
  394. end;
  395.  
  396. procedure TTeeAxForm.ComboBox1KeyPress(Sender: TObject; var Key: Char);
  397. begin
  398.   if Key=#13 then DownloadButtonClick(Self);
  399. end;
  400.  
  401. procedure TTeeAxForm.Timer1Timer(Sender: TObject);
  402. begin
  403.   Series1.Rotate(1);
  404. end;
  405.  
  406. procedure TTeeAxForm.FormCreate(Sender: TObject);
  407. begin
  408.   Series1.FillSampleValues(8);
  409. end;
  410.  
  411. procedure TTeeAxForm.CheckBox2Click(Sender: TObject);
  412. begin
  413.   Timer1.Enabled:=CheckBox2.Checked;
  414. end;
  415.  
  416. procedure TTeeAxForm.DownloadButtonClick(Sender: TObject);
  417. begin
  418.   Screen.Cursor:=crHourGlass;
  419.   try
  420.     DownloadChart;
  421.   finally
  422.     Screen.Cursor:=crDefault;
  423.   end;
  424. end;
  425.  
  426. procedure TTeeAxForm.BitBtn1Click(Sender: TObject);
  427. begin
  428.   With TTeeAboutForm.Create(Self) do
  429.   try
  430.     ShowModal;
  431.   finally
  432.     Free;
  433.   end;
  434. end;
  435.  
  436. procedure TTeeAxForm.Series1Click(Sender: TChartSeries;
  437.   ValueIndex: Integer; Button: TMouseButton; Shift: TShiftState; X,
  438.   Y: Integer);
  439. begin
  440.   ShowMessage('Visit www.'+Sender.XLabel[ValueIndex]+'.com !');
  441. end;
  442.  
  443. initialization
  444.   TActiveFormFactory.Create(
  445.     ComServer,
  446.     TActiveFormControl,
  447.     TTeeAxForm,
  448.     Class_ChartX,
  449.     1,
  450.     '',
  451.     OLEMISC_SIMPLEFRAME or OLEMISC_ACTSLIKELABEL);
  452. end.
  453.